home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Amiga-E / E_v3.2a_extras / PdSrc / Lang / Yax / xpaint.yax < prev    next >
Lisp/Scheme  |  1992-09-02  |  2KB  |  76 lines
  1. /* paint program using the new intuition functions */
  2.  
  3. (when (not (kick 37)) (write 'I need v37+!') (exit))
  4.  
  5. (string title)
  6. (set title 'Xpaint++ v0.1 by $#%!')
  7. (set maxx 320) (set maxy 200)
  8. (set col 1) (set tool 0) (set ox -1) (set oy -1)
  9. (set f 0) (set mode 0) (set off 30)
  10.  
  11. (set depth (+ (req title 'number of colours?' '4|8|16|2') 1))
  12. (set flags (* (req title 'mode?' 'hires|lowres') $8000))
  13. (set flags (+ flags (* (req title 'lace?' 'yes|no') 4)))
  14. (set maxy (+ maxy (* (req title 'pal?' 'yes|no') 56)))
  15. (if (> flags $7FFF) (set maxx (* maxx 2)))
  16. (if (and flags 4) (set maxy (* maxy 2)))
  17.  
  18. (screen maxx maxy depth flags title)
  19. (win 0 1 maxx (- maxy 1) $268 $100E title)
  20. (line 0 (- off 1) maxx (- off 1) 1)
  21. (gadget 1 5 15 55 'colour')
  22. (gadget 2 65 15 55 'tools')
  23. (gadget 3 125 15 55 'mode')
  24. (gadget 4 185 15 55 'clear')
  25. (gadget 5 245 15 55 'about')
  26. (set noquit 1)
  27.  
  28. (defun ymouse () (if (or (< (set d (mousey)) off) (> d maxy)) off d))
  29.  
  30. (defun dogad ()
  31.   (select (gadid)
  32.     1 (set col (req title 'pick colour:' '1|2|3|4|5|6|7|0'))
  33.     2 (do
  34.         (set tool (req title 'use tool:' 'poly|line|box|dot|free'))
  35.         (set ox -1) (set oy -1) (set f 0)
  36.       )
  37.     3 (set mode (req title 'mode:' 'cycle|mirror|norm'))
  38.     4 (box 0 off maxx maxy 0)
  39.     5 (req title 'Xpaint++ written in YAX!' 'ok')
  40.   )
  41. )
  42.  
  43. (defun dotool (x y)
  44.   (if (eq ox -1) (set ox x))
  45.   (if (eq oy -1) (set oy y))
  46.   (select mode
  47.     1 (set col (if (eq col 15) 1 (+ col 1)))
  48.     2 (set tool 4)
  49.   )
  50.   (select tool
  51.     0 (do
  52.         (while (eq (mouse) 1)
  53.           (set ox x) (set oy y)
  54.           (line ox oy (set x (mousex)) (set y (ymouse)) col)
  55.         )
  56.       )
  57.     1 (line ox oy x y col)
  58.     2 (do (if f (line ox oy x y col)) (set f (- 1 f)))
  59.     3 (do (if f (box ox oy x y col)) (set f (- 1 f)))
  60.     4 (do
  61.         (box x y (+ x 2) (+ y 2) col)
  62.         (if (eq mode 2) (box (- maxx x) y (+ (- maxx x) 2) (+ y 2) col))
  63.       )
  64.   )
  65.   (set ox x) (set oy y)
  66. )
  67.  
  68. (while noquit
  69.   (select (message)
  70.     $200 (set noquit 0)
  71.     $040 (dogad)
  72.     $020 (dogad)
  73.     $008 (dotool (mousex) (ymouse))
  74.   )
  75. )
  76.